module Gml.Evaluation (

    evaluate

) where

import Data.Maybe (fromJust)
import Gml.Token

evaluate :: TokenSequence -> TokenStack
evaluate sequence = eval sequence [] []

eval :: TokenSequence -> TokenStack -> Environment -> TokenStack
-- end of evaluation
eval [] stack _
    = stack
-- control operators
eval (ApplyToken : tokens) ((FunctionToken func) : stack) environment
    = eval tokens ((eval func stack []) ++ stack) environment
eval (IfToken : tokens) ((FunctionToken exp2) : (FunctionToken exp1) : (BoolToken True) : stack) environment
    = eval tokens ((evaluate exp1) ++ stack) environment
eval (IfToken : tokens) ((FunctionToken exp2) : (FunctionToken exp1) : (BoolToken False) : stack) environment
    = eval tokens ((evaluate exp2) ++ stack) environment
-- number operators
eval (AddiToken : tokens) ((IntToken x) : (IntToken y) : stack) environment
    = eval tokens ((IntToken (x + y) : stack)) environment
eval (AddfToken : tokens) ((RealToken x) : (RealToken y) : stack) environment
    = eval tokens ((RealToken (x + y) : stack)) environment
eval (ACosToken : tokens) ((RealToken x) : stack) environment
    = eval tokens ((RealToken (acos x) : stack)) environment
eval (ASinToken : tokens) ((RealToken x) : stack) environment
    = eval tokens ((RealToken (asin x) : stack)) environment
eval (ClampfToken : tokens) ((RealToken x) : stack) environment
    = eval tokens ((RealToken (clampf x) : stack)) environment
      where
        clampf x = if x < 0 then 0
                   else if x > 1 then 1
                   else x
eval (CosToken : tokens) ((RealToken x) : stack) environment
    = eval tokens ((RealToken (cos x) : stack)) environment
eval (DiviToken : tokens) ((IntToken x) : (IntToken y) : stack) environment
    = eval tokens ((IntToken (div x y) : stack)) environment
eval (DivfToken : tokens) ((RealToken x) : (RealToken y) : stack) environment
    = eval tokens ((RealToken (x / y) : stack)) environment
eval (EqiToken : tokens) ((IntToken x) : (IntToken y) : stack) environment
    = eval tokens ((BoolToken (x == y) : stack)) environment
eval (EqfToken : tokens) ((RealToken x) : (RealToken y) : stack) environment
    = eval tokens ((BoolToken (x == y) : stack)) environment
eval (FloorToken : tokens) ((RealToken x) : stack) environment
    = eval tokens ((IntToken (floor x) : stack)) environment
eval (FracToken : tokens) ((RealToken x) : stack) environment
    = eval tokens ((RealToken (snd (properFraction x)) : stack)) environment
eval (LessiToken : tokens) ((IntToken x) : (IntToken y) : stack) environment
    = eval tokens ((BoolToken (x < y) : stack)) environment
eval (LessfToken : tokens) ((RealToken x) : (RealToken y) : stack) environment
    = eval tokens ((BoolToken (x < y) : stack)) environment
eval (ModiToken : tokens) ((IntToken x) : (IntToken y) : stack) environment
    = eval tokens ((IntToken (mod x y) : stack)) environment
eval (MuliToken : tokens) ((IntToken x) : (IntToken y) : stack) environment
    = eval tokens ((IntToken (x * y) : stack)) environment
eval (MulfToken : tokens) ((RealToken x) : (RealToken y) : stack) environment
    = eval tokens ((RealToken (x * y) : stack)) environment
eval (NegiToken : tokens) ((IntToken x) : stack) environment
    = eval tokens ((IntToken (negate x) : stack)) environment
eval (NegfToken : tokens) ((RealToken x) : stack) environment
    = eval tokens ((RealToken (negate x) : stack)) environment
eval (ToRealToken : tokens) ((IntToken x) : stack) environment
    = eval tokens ((RealToken (fromIntegral x)) : stack) environment
eval (SinToken : tokens) ((RealToken x) : stack) environment
    = eval tokens ((RealToken (sin x) : stack)) environment
eval (SqrtToken : tokens) ((RealToken x) : stack) environment
    = eval tokens ((RealToken (sqrt x) : stack)) environment
eval (SubiToken : tokens) ((IntToken x) : (IntToken y) : stack) environment
    = eval tokens ((IntToken (x - y) : stack)) environment
eval (SubfToken : tokens) ((RealToken x) : (RealToken y) : stack) environment
    = eval tokens ((RealToken (x - y) : stack)) environment
-- point operators
eval (GetXToken : tokens) ((PointToken (x, _, _)) : stack) environment
    = eval tokens ((RealToken x) : stack) environment
eval (GetYToken : tokens) ((PointToken (_, y, _)) : stack) environment
    = eval tokens ((RealToken y) : stack) environment
eval (GetZToken : tokens) ((PointToken (_, _, z)) : stack) environment
    = eval tokens ((RealToken z) : stack) environment
eval (CreatePointToken : tokens) ((RealToken z) : (RealToken y) : (RealToken x) : stack) environment
      = eval tokens ((PointToken (x, y, z)) : stack) environment
-- array operators
eval (GetToken : tokens) ((ArrayToken array) : (IntToken index) : stack) environment
    = eval tokens ((array !! index) : stack) environment
eval (LengthToken : tokens) ((ArrayToken array) : stack) environment
    = eval tokens ((IntToken (length array)) : stack) environment
-- environment
eval ((IdentifierToken name) : tokens) stack environment
    = eval tokens ((identify name environment) : stack) environment
      where
        identify name environment =  fromJust (lookup name environment)
eval ((BinderToken name) : tokens) (token : stack) environment
    = eval tokens stack (bind name token environment)
      where
        bind name token environment = (name, token) : environment
-- types
eval (token : tokens) stack environment
    = eval tokens (token : stack) environment